perm filename PGSUB.2[MSS,LCS]1 blob
sn#242182 filedate 1976-10-18 generic text, type T, neo UTF8
00100 C**** VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
00200
00300 SUBROUTINE FILOUT(NAMQ,NPG)
00400 COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00500 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
00600 1 /SF/KL,RT,KP,STFSZ,NAMX
00700 MTR1=-1
00800 MTR2=-1
00900 NAMQ='AAAAA'
01000 103 FORMAT(' TYPE OUTPUT FILE NAME ',$)
01100 102 FORMAT(A5)
01200 TYPE 103
01300 ACCEPT 102,NAMX
01400 IF(NAMX.EQ.' ')NAMX=NAMQ
01500 NAMZ=NAMX
01600 NPG=1
01700 IF(LOOKF(NAMX).GE.0)GO TO 88
01800 TYPE 88,NAMX
01900 ACCEPT 102,L
02000 IF(L.EQ.'N')GO TO 103
02100 88 FORMAT(' WRITE OVER FILE ',A5,'???? '$)
02200 END
02300
02400 SUBROUTINE METER(MTR,R)
02500 COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
02600 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
02700 1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
02800 1 /SF/KL,RT,KP,STFSZ,NAMX
02900 K=MTR/100
03000 B=MTR-K*100
03100 A=K
03200 J=LPG
03300 1 RT=RSTNUM(J)
03400 C RT (IN COMMON) TRANSFERS THE STAFF NUM. TO SUBR. STAFF
03500 C PUT METER ON ALL STAVES FOR PAGE LAYOUT
03600 CALL STAFF(4.,18.,R,0,A,B,0,0)
03700 C PUTS IN METER AT START OF STAFF
03800 J=J-1
03900 IF(J.GT.0)GO TO 1
04000 MTR=-1
04100 END
04200
04300
04400 SUBROUTINE FILEIN
04500 COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
04600 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
04700 1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
04800 1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
04900 COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
05000 COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
05100 COMMON/STF/RSTFAC(-3/4),RSTJ2 /PX/KPN(1) /Q/Q(1)
05200 1 /NBAR/NBAR(36) /SIZE/SIZE
05300 EQUIVALENCE (LASTNM,KBAR(3))
05400
05500 IF(NBAR(LC).EQ.0)CALL EXIT
05600 IF(KPX.EQ.1)GO TO 104
05700 C SKIP THIS FIRST TIME. IT SHUFFLES DATA FORWARD IN ARRAY.
05800 J=KPX-1
05900 JJ=KPN(KPX)-1
06000 DO 105 K=1,NPX-J
06100 105 KPN(K)=KPN(K+J)-JJ
06200 J=KPN(NPX)-JJ
06300 C HOW MUCH TO SHIFT THE Q ARRAY
06400 DO 106 K=1,J
06500 106 Q(K)=Q(K+JJ)
06600 KPX =NPX-KPX+1
06700 C UPDATE POINTERS FOR NEXT READIN
06800 KQ=KPN(KPX)
06900 JPX=KQ-1
07000
07100 104 KL=1
07200 KP=1
07300 JEND=0
07400 C FLAG FOR PAGE END - WHEN -1
07500 CC RT=2
07600 CC J=KK
07700 CC HGT=HX*2.
07800 CC LD=0
07900 CC MTR1=-1
08000 CC K=KK-1
08100 IF(LB.LT.NBAR(LC))GO TO 220
08200 NPX=KPX
08300 KPX=1
08400 LB=0
08500 GO TO 241
08600 220 CALL GETFIL(NMPG)
08700 CALL FASTIN(RSTFAC,22)
09700 211 CALL FASTIN(KPN(KPX),JJ2)
09800 CALL FASTIN(Q(KQ),JPQ)
09900 IF(KPX.EQ.1)GO TO 140
10000 DO 420 JP=KPX,JJ2+KPX-1
10100 420 KPN(JP)=KPN(JP)+JPX
10200
10300 140 JPX=KQ+JPQ-3
10400 C NUM OF WORDS TO SHIFT.
11200 41 NMPG=NMPG+2
11300 C NMPG = NAME OF INPUT FILES
11400 CC L=JJ2-2
11500 CC NPX=KPX+L
11600 NPX=KPX+JJ2-2
11700 241 JBAR=NBAR(LC)
11800 DO 20 JP=KPX,NPX-1
11900 N=KPN(JP)
12000 IF(Q(N+1).NE.4)GO TO 20
12100 C FINDS BAR LINES IN THIS PART OF DATA
12200 LB=LB+1
12300 IF(LB.NE.JBAR)GO TO 20
12400 KPX=JP+1
12500 520 IF(Q(KPN(KPX)+1).NE.18)GO TO 20
12600 C LOOKS FOR METER BEYOND LAST BAR IN LINE
12700 IF(KPX.GE.NPX)GO TO 20
12800 KPX=KPX+1
12900 GO TO 520
13000 20 CONTINUE
13100 IF(LB.GE.JBAR)GO TO 120
13200 KPX=NPX
13300 KQ=JPX+1
13400 GO TO 220
13500 120 KQ=KPN(KPX)
13600 LB=LB-JBAR
13700 L=KPX-1
13800 C L=TOTAL ITEMS FOR THIS LINE. JBAR=TOTAL BARS, LB=HOW MANY LEFT OVER
13900 I=L
14000 IF(LB.NE.0)RETURN
14100 KPX=1
14200 KQ=1
14300 END
14400
14500 SUBROUTINE STAVES
14600 DATA SLSP/12.0/
14610 DIMENSION BEG(500)
14700 COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
14800 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
14900 COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
15000 1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4)
15100 1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
15200 COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
15300 COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/OSLUR(1)
15400 COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
15500 1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
15600 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
15700 1,(R8,RQ(6)),(R9,RQ(7)),(BEG,RN(2001))
15710 C BEG ARRAY WILL STORE END OF LINE CARRYOVER STUFF.
15800 IF(LC.EQ.1)RA=0
15900 C RA IS LEFT POS OF Q DATA. (IT SHIFTS AS LC CHANGES.)
16000 KL=1
16100 KP=1
16200 LC=LC+1
16300 335 RX=0
16400 IF(NBAR(LC).EQ.0)JEND=-1
16500 3 JJ=KP
16600
16700 C ******** PUTS IN STAFF ********
16800 RS=3.
16900 C RS IS WDCNT FOR SUBR. STAFF
17000 IF(RT.NE.0)GO TO 331
17100 C NEXT FOR BOTTOM STAFF. PUTS IN SPACER.
17200 RS=6.
17300 331 IF(IPG)GO TO 411
17400 HX=8
17500 RZ=0
17600 RX=RT
17700 DO 611 JP=1,LPG
17800 RT=RSTNUM(JP)
17900 RS=3
18000 C WD CNT IS RS, HX IS CODE(8), ARRAYS AND LPG(JPG) WERE SET UP IN MAIN.
18100 RR=0
18200 IF(JP.GT.1)GO TO 611
18300 IF(NAMX.EQ.NAMZ)GO TO 611
18400 RS=6
18500 RR=SPG
18600 C FOR SPACER ON STAFF 0
18700 611 CALL STAFF(RS,HX,RZ,RHGT(JP),RPSZ(JP),RZ,RZ,RR)
18800 HX=LPG
18900 RS=4.
19000 RT=0
19100 CALL STAFF(2.,RS,RZ,HX,RZ,RZ,RZ,RZ)
19200 IF(BRACK.NE.0)CALL STAFF(5.,RS,RZ,HX,RZ,RZ,BRACK,RZ)
19300 RT=RX
19400 GO TO 511
19500 411 CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,SP)
19600 HGT=HGT-HX
19700 511 IF(JEND)GO TO 60
19800 C FOR PREMATURE PAGE END
19900 CP IF(K.NE.I)GO TO 6
20000 IF(RT.EQ.0)GO TO 6
20100 60 IF(IPG.EQ.0)GO TO 6
20200 RX=RT
20300 RT=0
20400 CALL STAFF(6.,8.,0,0,0,0,1.,SP)
20500 C PUTS IN SPACER
20600 RT=RX
20700
20800 6 IF(JSLUR.EQ.0)GO TO 333
20900 C ***** PUT SLUR AT END OF LINE ********
21000 JSLUR=0
21100 K4=2
21200 K5=3
21300 K7=4
21400 RT=OSLUR(1)
21500 1333 CALL STAFF(5.,5.,0,OSLUR(K4),OSLUR(K5),SLSP,OSLUR(K7),0)
21600 IF(JSL2.EQ.0)GO TO 333
21700 C FOR 2ND SLUR AT END OF LINE.
21800 JSL2=0
21900 K4=6
22000 K5=7
22100 K7=8
22200 RT=OSLUR(5)
22300 GO TO 1333
22400
22500 C ****** NEXT FOR CLEFS ************
22600 333 IF(CLEF.EQ.-99)GO TO 33
22700 C ONLY STAFF FOR FIRST LINE AT TOP.
22800 RX=8.*RSTJ2
22900 C THE SPACER
23000 LA=0
23100 IF(IPG)GO TO 3011
23200 LA=LPG
23300 3111 RT=RSTNUM(LA)
23400 LL=RT
23500 CLEF=RCLEF(LL)
23600 C GETS CLEF FOR PAGE LAYOUT, RT IS STAFF# IN CALL
23700 LA=LA-1
23800 3011 CALL STAFF(3.,3.,1.5,0,CLEF,0,0,0)
23900 IF(SIG.EQ.-99)GO TO 3211
24000 C ***** NEXT FOR KEY SIG. ********
24100 RS=4.
24200 R5=SIG
24300 332 CALL STAFF(RS,17.,10.0*RSTJ2,0,R5,CLEF,0,0)
24400 3211 IF(LA.GT.0)GO TO 3111
24500 RX=11.*RSTJ2
24600 C RX SETS POS OF NEXT ITEM ON STAFF
24700 R7=RX
24800
24900 C ***** NEXT FOR METER CHANGES TO APPEAR AT START OF STAFF*****
25000 33 IF(MTR1)GO TO 31
25100 R=R7+RSTJ2*3
25200 CALL METER(MTR1,R)
25300 C PUT METER ON ALL STAVES FOR PAGE LAYOUT
25400 C PUTS IN METER AT START OF STAFF
25500 IF(MTR2)GO TO 5211
25600 R=7.5*RSTJ2+R7
25700 CALL METER(MTR2,R)
25800 C PUTS COMPOSITE METER AFTER END OF STAFF
25900 5211 RX=R+RSTJ2
26000 C RX SPACES NEXT ITEM TO RIGHT OF LINE BEGINNING.
26100 31 R4=RA
26200 LA=I
26300 231 K4=KPN(LA)
26400 R=Q(K4+1)
26500 IF(R.EQ.4)GO TO 131
26600 LA=LA-1
26700 GO TO 231
26800 131 R5=Q(K4+3)
26900 RS=0
27000 R7=RT
27100 R8=RX
27200 R9=200.
27300 LL=0
27400 L=I
27500 CALL PTMOVE(Q,KPN)
27600 RA=R5
27700 IF(LA.EQ.I)RETURN
27800 C NEXT PUTS METER JUST BEYOND END OF LINE
27900 R=202
28000 R7=Q(KPN(LA+1)+3)
28100 C R7 HOLDS STAFF NUM. FOR THINGS BEYOND END OF LINE.
28200 DO 431 K5=LA+1,I
28300 K7=KPN(K5)
28400 K4=0
28500 IF(Q(K7+1).EQ.18)K4=Q(K7+5)*100+Q(K7+6)
28600 C K4 STORES METER (TOP*100+BOTTOM)
28700 IF(Q(K7+3).EQ.R7)GO TO 531
28800 R7=Q(K7+3)
28900 C THIS PROBABLY WON'T ALWAYS DO THE RIGHT THING!!
29000 R=R+5
29100 IF(MTR1.GT.0.AND.K4.NE.0)MTR2=K4
29200 531 IF(K4.NE.0.AND.MTR1)MTR1=K4
29300 431 Q(K7+3)=R
29400 END
29500